home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / propage / genies / frenchgenies / rexx / histogrammehorizontal.pprx < prev    next >
Text File  |  1993-08-03  |  4KB  |  176 lines
  1. /*@BHsitogramme Horizontal @P@I© Michael S. Fahrion. Janvier 1992
  2. Débuggé et amélioré par Don Cox.
  3.  
  4. Ce Génie crée un histogramme horizontal à partir des données fournies par
  5. l'utilisateur.
  6. */
  7.  
  8. numeric digits 8
  9. cr = '0a'x
  10. call SafeEndEdit.rexx()
  11. call ppm_AutoUpdate(0)
  12. call ppm_NewGroup()
  13.  
  14. units = ppm_GetUnits()
  15. call ppm_SetUnits(1)
  16.  
  17. signal on halt
  18. signal on break_c
  19. signal on break_e
  20. signal on break_d
  21.  
  22. box = ppm_ClickOnBox("Cliquez sur la boîte destinée à contenir l'histogramme...")
  23.  
  24. if box = 0 then
  25. do
  26.     call ppm_Inform(1, "Aucune boîte n'est sélectionnée",)
  27.     call ppm_ClearStatus()
  28.     exit
  29. end
  30.  
  31. /*  extract box attributes  */
  32. boxsize = ppm_GetBoxSize(box)
  33. boxpos = ppm_GetBoxPosition(box)
  34.  
  35. if ppm_Inform(2, "Effacer cette boîte ?",) = 1 then call ppm_DeleteBox(box)
  36.  
  37. boxwidth = word(boxsize, 1)
  38. boxheight = word(boxsize, 2)
  39. boxleft = word(boxpos, 1)
  40. boxtop = word(boxpos, 2)
  41. /* trace(results) */
  42.  
  43. nmbars = GetUserText(4, "Nombre de données")
  44. if nmbars > 12 then exit_msg("Le nombre de données ne doit pas être supérieur à 12")
  45.  
  46. form = ' Donnée 1'
  47. do x = 2 while x <= nmbars
  48.  form = form cr 'Donnée' x
  49. end
  50. form = form cr 'Echelle'
  51.  
  52. form = ppm_GetForm("Données de l'histogramme",6,form)
  53. if form = "" then exit_msg("Opération annulée")
  54.  
  55. x = 1
  56. do forever
  57.   parse var form bdata.x '0a'x form
  58.   if bdata.x = "" then leave
  59.   x = x + 1
  60. end
  61. tchart = nmbars + 1
  62. topchart = bdata.tchart
  63.  
  64. form = ' Légende 1'
  65. do x = 2 while x <= nmbars
  66.    form = form cr 'Légende' x
  67. end
  68.  
  69. form = ppm_GetForm("Légendes de l'histogramme",8,form)
  70. if form = "" then exit_msg("Opération annulée")
  71.  
  72. x = 1
  73. do forever
  74.    parse var form blabel.x '0a'x form
  75.    if blabel.x = "" then leave
  76.    x = x + 1
  77. end
  78.  
  79. facelist = ppm_GetTypeFaceList()
  80. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  81. face = ppm_SelectFromList("Choix de la Police",32,18,0,facelist)
  82.  
  83. /* Draw background chart and grid lines */
  84.  
  85. barbottom = boxtop + boxheight
  86.  
  87. call ppm_ShowStatus("Création de l'histogramme")
  88. linespace = boxwidth / 10
  89. gridline = linespace + boxleft
  90.  
  91. call ppm_SetLineWeight(.5)
  92. do 9
  93.   call ppm_DrawLine(gridline, boxtop, gridline, boxtop + boxheight)
  94.   gridline = gridline + linespace
  95.   call ppm_AddToGroup()
  96. end
  97.  
  98. call ppm_SetLineWeight(1)
  99. call ppm_SetFillPattern(0)
  100. call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
  101. call ppm_AddToGroup()
  102.  
  103. call ppm_MergeGroup()
  104.  
  105. /* add chart numbers */
  106.  
  107. call ppm_ShowStatus("Mise en place de l'échelle de l'histogramme")
  108. call ppm_SetFont(face)
  109. call ppm_SetSize(10)
  110. call ppm_SetStyle(N)
  111. call ppm_SetJustification(2)
  112.  
  113. bleft = (boxleft + boxwidth - .25)
  114. btop = boxtop + boxheight + .05
  115. ctext = topchart
  116. ctextadjust = topchart / 10
  117. i = 1
  118.  
  119. do 11
  120.   cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
  121.   bleft = bleft - linespace
  122.   call ppm_TextIntoBox(cbox, ctext)
  123.   ctext = topchart - (ctextadjust * i)
  124.   i = i + 1
  125. end
  126.  
  127. /* Draw chart bars */
  128.  
  129. barcalc = boxwidth / topchart
  130. barspace = (nmbars + 1) * .125
  131. barwidth = (boxheight - barspace) / nmbars
  132. barpos = boxtop + .125
  133. call ppm_SetFillPattern(5)
  134.  
  135. i = 1
  136.  
  137. do nmbars
  138.   call ppm_ShowStatus("Travail en cours sur la donnée : " i)
  139.   barlength = bdata.i * barcalc
  140.   barlength = boxleft + barlength
  141.   call ppm_DrawRect(boxleft, barpos, barlength, barpos + barwidth)
  142.  
  143.   call ppm_SetJustification(1)
  144.   cbox = ppm_CreateBox(boxleft - .53, barpos, .5, .25, 0)
  145.   call ppm_TextIntoBox(cbox, upper(blabel.i))
  146.   call ppm_SetJustification(0)
  147.   cbox = ppm_CreateBox(barlength + .05, barpos, .3, .15, 0)
  148.   call ppm_SetBoxTransparent(cbox,0)
  149.   call ppm_TextIntoBox(cbox, bdata.i)
  150.   barpos = barpos + barwidth + .125
  151.   i = i + 1
  152. end
  153.  
  154. exit_msg("Terminé")
  155. break_d:
  156. break_e:
  157. break_c:
  158. halt:
  159.     call exit_msg("Abandon du Génie par l'utilisateur !")
  160.  
  161. exit_msg: procedure expose units
  162. do
  163.    parse arg message
  164.  
  165.     call ppm_ClearStatus()
  166.  
  167.    if message ~= '' then
  168.        call ppm_Inform(1, message,)
  169.  
  170.    call ppm_SetUnits(units)
  171.    call ppm_ClearStatus()
  172.    call ppm_AutoUpdate(1)
  173.    exit
  174. end
  175.  
  176.